home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Menus / codeWarriorMenu.tcl next >
Encoding:
Text File  |  1998-12-04  |  15.9 KB  |  561 lines  |  [TEXT/ALFA]
  1. #=== nowrap =====================================================================
  2. #
  3. #             CodeWarrior Interaction
  4. #
  5. # Metrowerks currently has an incomplete appleevent interface. 
  6. # Apple events can be used to direct CodeWarrior to compile
  7. # or add individual files, make the project, etc. However, 
  8. # there is currently no provision to report specific errors
  9. # back to the controller.
  10. #
  11. #================================================================================
  12.  
  13. alpha::menu codewarriorMenu 1.2.1 "C C++ Java Pasc" "•268" {
  14. } {codewarriorMenu} {} uninstall {this-file} maintainer {
  15.     "No-one"
  16. } help {file "CodeWarrior"}
  17.  
  18. alpha::package require searchPaths 1.0
  19. set cwdebugMenu    "•274"
  20.  
  21. hook::register savePostHook cw::modified "Java" "Pasc" "C++" "C"
  22. newPref flag debugger 0 cw
  23. newPref flag switchWhenCompiling 1 cw
  24. newPref var SearchPath "" cw
  25.  
  26. ensureset CWCompilerSig CWIE
  27. ensureset CWDebuggerSig MWDB
  28.  
  29. namespace eval cw {}
  30.  
  31. proc codewarriorMenu {} {}
  32.  
  33. Menu -n "$codewarriorMenu" -p cw::menuProc {
  34.     "help"
  35.     "/-<UswitchToIde"
  36.     {Menu -m -n werksFlags {}}
  37.     "createFileset"
  38.     {Menu -m -n headers {}}
  39.     "(-"
  40.     "addFile"
  41.     "/K<Ucompile"
  42.     "compileFiles"
  43.     "checkSyntax"
  44.     "precompile…"
  45.     "(-"
  46.     "openHeader"
  47.     "(-"
  48.     "/U<Uupdate"
  49.     "/M<Umake"
  50.     "(-"
  51.     "/D<UgotoDebugger"
  52.     "/B<UsetBreakpoint"
  53.     "clearBreakpoint"
  54.     "/J<UshowSource"
  55.     "(-"
  56.     "/N<UnextError"
  57.     "/P<UprevError"
  58.     "/R<Urun"
  59. }
  60.  
  61. menu::buildFlagMenu werksFlags array cwmodeVars
  62. mode::rebuildSearchPathMenu 
  63.  
  64. proc cw::help {} {
  65.     global HOME
  66.     edit -r [file join $HOME Help CodeWarrior]
  67. }
  68.  
  69. set CWCLASS        MMPR
  70. set CDCLASS        MWDB
  71.  
  72. proc cw::nextError {} {
  73.     nextMatch "*Compiler Errors*"
  74. }
  75.  
  76. proc cw::prevError {} {
  77.     prevMatch "*Compiler Errors*"
  78. }
  79.  
  80. proc cw::menuProc {menu item} {
  81.     cw::$item
  82. }
  83.  
  84. proc cw::switchToIde {} {
  85.     global CODEWarrior
  86.     cw::check
  87.     switchTo $CODEWarrior
  88. }
  89.  
  90. proc cw::make {} {cw::killErrors; cw::Do Make}
  91. proc cw::update {} {cw::Do UpdP}
  92.  
  93. proc cw::Do {param} {
  94.     global CODEWarrior CWCLASS ALPHA
  95.     cw::check
  96.     switchTo $CODEWarrior
  97.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS $param "Errs" "bool(«01»)"]]]} {
  98.     cw::errors $res
  99.     }
  100. }
  101.  
  102. proc cw::run {} {
  103.     global CODEWarrior CWCLASS ALPHA cwmodeVars
  104.     cw::check
  105.     cw::killErrors
  106.     set bug $cwmodeVars(debugger)
  107.     switchTo $CODEWarrior
  108.     if {[string length [set res [AEBuild -r -t 500000 $CODEWarrior $CWCLASS RunP "Errs" "bool(«01»)" DeBg $bug]]]} {
  109.     cw::errors $res
  110.     }
  111. }
  112.  
  113. proc cw::precompile {} {
  114.     global CODEWarrior CWCLASS res
  115.     cw::check
  116.     set fname [win::Current]
  117.     set targ [putfile "Precompile target:"]
  118.     switchTo $CODEWarrior
  119.     if {[string length [set res [AEBuild $CODEWarrior $CWCLASS PreC "----" [makeAlis $fname] "Errs" "bool(«01»)" Targ [makeAlis $targ]]]] > 40} {
  120.     cw::errors $res
  121.     } else {
  122.     if {[regexp {errn:([-0-9]+)} $res dummy errno]}  {
  123.         message "Error number: $errno"
  124.     }
  125.     }
  126. }
  127.  
  128. proc cw::addFile {} {
  129.     global CODEWarrior CWCLASS
  130.     cw::check
  131.     switchTo $CODEWarrior
  132.     set fname [win::Current]
  133.     set res [AEBuild -t 500000 -q $CODEWarrior $CWCLASS AddF "----" [makeAlis $fname]]
  134. }
  135.  
  136. proc cw::checkSyntax {} {
  137.     global CODEWarrior CWCLASS res
  138.     cw::check
  139.     #    switchTo $CODEWarrior
  140.     set fname [win::Current]
  141.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Chek "----" [concat {[alis(«} [coerce TEXT $fname -x alis] {»)]}] "Errs" "bool(«01»)"]]] > 40} {
  142.     cw::errors $res
  143.     }
  144. }
  145.  
  146.  
  147. proc cw::killErrors {} {
  148.     set wins [winNames]
  149.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  150.     set name [lindex $wins $res]
  151.     bringToFront $name
  152.     killWindow
  153.     }
  154. }    
  155.  
  156.  
  157. proc cw::compile {} {
  158.     global CODEWarrior CWCLASS res ALPHA cwmodeVars
  159.     save
  160.     cw::check
  161.     set fname [win::Current]
  162.     cw::killErrors
  163.     if {$cwmodeVars(switchWhenCompiling)} {
  164.     switchTo $CODEWarrior
  165.     }
  166.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlis $fname] "Errs" "bool(«01»)"]]] > 40} {
  167.     cw::errors $res
  168.     }
  169.     switchTo $ALPHA
  170. }
  171.  
  172.  
  173. proc cw::compileFiles {} {
  174.     global CODEWarrior CWCLASS res ALPHA win::Modes
  175.     saveAll
  176.     cw::check
  177.     set files {}
  178.     set wins [winNames -f]
  179.     set md [set win::Modes([lindex $wins 0])]
  180.     foreach w $wins {
  181.     if {$md == [set win::Modes($w)]} {
  182.         lappend files $w
  183.     }
  184.     }
  185.     cw::killErrors
  186.     switchTo $CODEWarrior
  187.     if {[string length [set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS Comp "----" [makeAlises $files] "Errs" "bool(«01»)"]]] > 40} {
  188.     cw::errors $res
  189.     }
  190.     switchTo $ALPHA
  191. }
  192.  
  193.  
  194. proc cw::GetFiles {} {
  195.     global CODEWarrior CWCLASS
  196.     cw::check
  197.     set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GSeg]
  198.     regexp {\[(.*)\]} $res dummy segs
  199.     regsub -all {, Seg} $segs {•} segs
  200.     set ind 1
  201.     foreach seg [split $segs {•}] {
  202.     regexp {NumF:([0-9]+)} $seg dummy num
  203.     
  204.     while {$num > 0} {
  205.         set res [AEBuild -t 500000 -r $CODEWarrior $CWCLASS GFil "----" "long($num)" Segm "long($ind)"]
  206.         if {[regexp {FTxt} $res]} {
  207.         regexp {«(.*)»} $res dummy spec
  208.         set f [specToPathName $spec]
  209.         message $f
  210.         lappend files $f
  211.         }
  212.         incr num -1
  213.     }
  214.     incr ind
  215.     }
  216.     return $files
  217. }
  218.  
  219. proc cw::createFileset {} {
  220.     codewarriorCreateFileset
  221.     rebuildAllFilesets
  222. }
  223.  
  224.  
  225. proc codewarriorCreateFileset {} {
  226.     global gfileSets gfileSetsType modifiedArrayElements
  227.     
  228.     set name [prompt "Fileset name? " "CodeWarrior"]
  229.     set gfileSets($name) [lsort -command sortByTail [cw::GetFiles]]
  230.     set gfileSetsType($name) codewarrior
  231.     
  232.     if {[askyesno "Save project fileset?"] == "yes"} {
  233.     lappend modifiedArrayElements [list $name gfileSets] \
  234.       [list $name gfileSetsType]
  235.     }
  236.     return $name
  237. }
  238.  
  239.  
  240. # the error reply from CodeWarrior looks like this
  241. # [ErrM{ErrT:ErCW, ErrS:“function declaration hides inherited virtual function”, file:fss («FFFB000014371443536D617274537464506F7075704D656E752E6800000000000000000000000000000000000000000000000000000000000000000000000000000000000000»), ErrL:64}, ...]
  242. #
  243. # ErrT is the error type parameter
  244. #     ErCW indicates a warning
  245. #     ErCE indicates an error
  246. # Improvements by jdunning@cs.Princeton.EDU (John Dunning)
  247. proc cw::errors {res} {    
  248.     global win::Modes tileLeft tileTop tileWidth errorHeight
  249.     
  250.     if {[regexp {\[.*\]} $res res]} {
  251.     # trim off the outside brackets
  252.     set res [string trim $res {[]}]
  253.     
  254.     # replace all the returns in the error list with spaces.  this is 
  255.     # necessary because CW 7.0 can return multi-line error messages,
  256.     # which aren't processed correctly by this function.
  257.     regsub -all "\r" $res " " res
  258.     
  259.     # delete the first ErrM, and replace the remaining ones (and the preceeding commas)
  260.     # with returns
  261.     regsub {ErrM} $res "" res
  262.     regsub -all {, ErrM} $res "\r" res
  263.     
  264.     set text ""
  265.     set errors 0
  266.     set warnings 0
  267.     set messages 0
  268.     set link 0
  269.     
  270.     # split the string into separate lines, one error per line.  only process
  271.     # process the first 101 errors
  272.     foreach err [lrange [split $res "\r"] 0 100] {
  273.         # the last two letters in ErrT:Er.. signal whether it's a compile (C) or link (L)
  274.         # error and whether it's an error (E) or a warning (W).  stick the rest of
  275.         # the error message back into err.
  276.         if {[regexp {ErrT:Er(.)(.),[ \t]*(.*)} $err unused compileOrLink errorOrWarning err]} {
  277.         if {$errorOrWarning == "E"} {
  278.             # mark actual errors with a bullet
  279.             append text " • "
  280.             incr errors
  281.         } else {
  282.             # mark warnings with a delta
  283.             append text " Δ "
  284.             incr warnings
  285.         }
  286.         
  287.         if {$compileOrLink == "C"} {
  288.             # we have a compile error, so strip out the error message, the filespec
  289.             # and the line number
  290.             if {[regexp {ErrS:“(.*)”.*«(.*)».*ErrL:([0-9]+)} $err unused errorString fileSpec lineNumber]} {
  291.             # conver the filespec that was returned in the apple event into a pathname
  292.             # so we can display it
  293.             set pathName [specToPathName $fileSpec]
  294.             
  295.             # append the file name (the tail of the pathname), the line number,
  296.             # the error string, lots of tabs, and then the full pathname
  297.             append text "\"[file tail $pathName]\"\t; Line $lineNumber: $errorString\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$pathName\r"
  298.             }
  299.         } else {
  300.             # we got a link error
  301.             set link 1
  302.             
  303.             # just strip out the error message.  the file the error occurs in doesn't 
  304.             # seem to get included in the event
  305.             if {[regexp {ErrS:“(.*)”} $err unused errorString]} {
  306.             # append the error message
  307.             append text "$errorString\r"
  308.             }
  309.         }
  310.         } elseif {[regexp {“([^:]*): (.*)”} $err unused fileName message]} {
  311.         # we got some sort of message, so strip out the associated file name and 
  312.         # the message.  I'm not sure if CodeWarrior still returns anything of this form.
  313.         append text "\"$fileName\" ; $message\r"
  314.         incr messages
  315.         }
  316.     }
  317.     
  318.     set wins [winNames]
  319.     if {$errors == 0 && $warnings == 0 && $messages == 0} {
  320.         global killCompilerErrors
  321.         set killCompilerErrors 1
  322.         return
  323.     }
  324.     
  325.     new -n {* Compiler Errors *} -g $tileLeft $tileTop $tileWidth $errorHeight -m Brws
  326.     if {$link} {
  327.         insertText "(Link: $errors errors, $warnings warnings, $messages messages)\r-----\r$text"
  328.     } else {
  329.         insertText "($errors errors, $warnings warnings, $messages messages: <cr> to go to line)\r-----\r$text"
  330.     }
  331.     
  332.     display [minPos]
  333.     winReadOnly
  334.     downBrowse
  335.     gotoMatch
  336.     }
  337. }
  338.  
  339.  
  340.  
  341. proc cw::modified {fname} { 
  342.     global CWCLASS CODEWarrior
  343.     cw::checkRunning
  344.     AEBuild -t 500000 $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]
  345. }
  346.  
  347. proc cw::Touch {} {
  348.     global CODEWarrior CWCLASS
  349.     cw::check
  350.     switchTo $CODEWarrior
  351.     set fname [win::Current]
  352.     set res [AEBuild -t 500000 $CODEWarrior $CWCLASS "Toch" "----" [makeAlis $fname]]
  353. }
  354.  
  355. proc cw::check {} {
  356.     global CODEWarrior modifiedVars CWCompilerSig 
  357.     app::launchElseTryThese {CWIE MMCC MPCC} CWCompilerSig
  358.     set CODEWarrior [file tail [app::launchBack $CWCompilerSig]]
  359. }
  360.  
  361. proc cw::checkDebug {} {
  362.     global CODEDEBUGGER CWDebuggerSig modifiedVars
  363.     app::launchElseTryThese {MPDB MWDB} CWDebuggerSig
  364.     set CODEDEBUGGER [file tail [app::launchBack $CWDebuggerSig]]
  365. }
  366.  
  367. proc cw::gotoDebugger {} {
  368.     global CODEDEBUGGER
  369.     cw::checkDebug
  370.     switchTo $CODEDEBUGGER
  371. }
  372.  
  373. proc cw::setBreakpoint {} {
  374.     global CODEDEBUGGER CDCLASS res
  375.     cw::checkDebug
  376.     switchTo $CODEDEBUGGER
  377.     set fname [win::Current]
  378.     set ln [lindex [posToRowCol [getPos]] 0]
  379.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Sbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  380. }
  381.  
  382. proc cw::clearBreakpoint {} {
  383.     global CODEDEBUGGER CDCLASS res
  384.     cw::checkDebug
  385.     switchTo $CODEDEBUGGER
  386.     set fname [win::Current]
  387.     set ln [lindex [posToRowCol [getPos]] 0]
  388.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Cbrk" "----" [makeAlis $fname] "Line" "long($ln)"]
  389. }
  390.  
  391.  
  392. proc cw::showSource {} {
  393.     global CODEDEBUGGER CDCLASS res
  394.     cw::checkDebug
  395.     switchTo $CODEDEBUGGER
  396.     set fname [win::Current]
  397.     set ln [lindex [posToRowCol [getPos]] 0]
  398.     set res [AEBuild -t 500000 -r $CODEDEBUGGER $CDCLASS "Show" "----" [makeAlis $fname] "Line" "long($ln)"]
  399. }
  400. #  "Soff" "long([getPos]" "Eoff" "long([selEnd])"
  401.  
  402. proc cw::openHeader {} {
  403.     if {[regexp {#include.*("|<)(.*)("|>)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] d1 d1 inc]} {
  404.     return [editIncludeFile $inc]
  405.     }
  406.     message "No include file found on this line!"
  407.     beep
  408. }
  409.  
  410.  
  411. ## 
  412.  # from old "codeWarriorMenu+.tcl"                                       
  413.  #                                                                       
  414.  # July 15, 1996       Jonathan E. Guyer   <mailto:j-guyer@nwu.edu>  
  415.  #                                                                   
  416.  # These routines implement an includes list for CodeWarrior when you 
  417.  # option-click in the title bar.  It requires CodeWarrior IDE 1.6 or 
  418.  # greater (earlier versions didn't return file dependencies with 
  419.  # «MMPRGFil» events.
  420.  #                                                                            
  421.  # As discussed within the code, it's not the                                 
  422.  # most efficient thing in the world, due to the IDE's                        
  423.  # dain-bramaged object model. I hope to improve this in the future.          
  424.  ##
  425.  
  426. proc cw::checkRunning {} {
  427.     global CODEWarrior CWCompilerSig launchIDEifRequired
  428.     if ![app::isRunning $CWCompilerSig CODEWarrior] {
  429.     if ![app::isRunning {CWIE MMCC MPCC} CODEWarrior CWCompilerSig] {
  430.         error "Not running"
  431.     }
  432.     }
  433. }
  434.  
  435. proc cw::include {name} {
  436.     global CODEWarrior cwpaths 
  437.     
  438.     # This may be more trouble than    it's worth:
  439.     # I got    tired of "* CodeWarrior    Not Running *" messages    when it    _was_ running
  440.     #    (CODEWarrior wasn't defined yet) but this way it'll launch CW on an option-click, 
  441.     #    whether    you want it to or not.
  442.     cw::checkRunning
  443.     
  444.     # Make sure the    file is    in the current project before we start iterating 
  445.     #    through    all its    files.
  446.     
  447.     set blah [AEBuild -r $CODEWarrior "MMPR" "FInP"    "----" "TEXT(“[file tail $name]”)"]
  448.     # aevt\ansr{'----':[?]}
  449.     if {![regexp {'----':\[([^]]*)\]} $blah    dummy errCode]}    {
  450.     # aevt\ansr{errn:????}
  451.     regexp {errn:([-0-9]*)}    $blah dummy errCode
  452.     }
  453.     
  454.     # error    codes defined in CWAppleEvents.h in CodeWarrior's MacOS    Examples
  455.     if         {$errCode == 1} {
  456.     # errShell_ActionFailed
  457.     set theReply {{(Action Failed}}
  458.     } elseif {$errCode == 2} {
  459.     # errShell_FileNotFound
  460.     set theReply {{(Not in current CW project}}
  461.     } elseif {$errCode == 6} {
  462.     # errShell_NoOpenProject
  463.     set theReply {{(No project open    in CW}}
  464.     } elseif {$errCode != 0} {
  465.     lappend    theReply "(CW AppleEvent Error:    $errCode"
  466.     }
  467.     
  468.     if {![info exists theReply]} {
  469.     
  470.     if {[info exists cwpaths]} {unset cwpaths}
  471.     
  472.     # CodeWarrior is a pain    in the ass about this and won't    just 
  473.     #    return the file    with a given name so we:
  474.     
  475.     # get list of Segments
  476.     
  477.     set blah [AEBuild -r $CODEWarrior "MMPR" "GSeg"]
  478.     # aevt\ansr{'----':[Seg    {...}, Seg {...}, ...]}
  479.     if {![regexp {aevt\\ansr\{'----':\[.+\]\}} $blah]} {return {{(Empty project}}}
  480.     
  481.     # strip    out everthing down to a    list of    file counts
  482.     
  483.     set fileCountList ""
  484.     # ... Seg {... NumF:??,    ...}, ...
  485.     while {[regexp -indices    {NumF:([0-9]*),?} $blah    dummy mtchRange]} {
  486.         set fileCountList [concat $fileCountList " " [string range $blah [lindex $mtchRange 0] [lindex $mtchRange 1]]]
  487.         set blah [string range $blah [expr [lindex $mtchRange 1] + 1] [string length $blah]]
  488.     }
  489.     
  490.     # then iterate through each file in each segment 
  491.     #    until we find what we're looking for
  492.     
  493.     set segmentNumber 0
  494.     set foundFile 0
  495.     foreach    fileCount $fileCountList {
  496.         incr segmentNumber
  497.         for {set fileNumber 1} {$fileNumber <= $fileCount} {incr fileNumber} {
  498.         set blah [AEBuild -r $CODEWarrior "MMPR" "GFil"    "----" $fileNumber "Segm" $segmentNumber]
  499.         # aevt\ansr{'----':SrcF{... pnam:“?????.??” ...}}
  500.         regexp {pnam:“([^”]*)”}    $blah dummy fileName
  501.         if {$fileName == $name}    {
  502.             set foundFile 1
  503.             break
  504.         }
  505.         }
  506.         if {$foundFile}    {
  507.         break
  508.         }
  509.         
  510.     }
  511.     
  512.     # and finally break down the list of included files, 
  513.     
  514.     if {$foundFile}    {
  515.         # aevt\ansr{'----':SrcF{... IncF:[fss («...»), ... ] ...}}
  516.         regexp {IncF:\[([^]]*)\]} $blah    dummy raw
  517.         if {$raw == ""}    {return    {{(No includes}}}
  518.         # fss («??????»), fss («??????»), ... ,    fss («??????») ...
  519.         regsub -all {»[^«]*«} $raw { } raw
  520.         # fss («?????? ?????? ... ??????») ...
  521.         regsub {[^«]*«}    $raw {}    raw
  522.         # ?????? ??????    ... ??????») ...
  523.         regsub {».*} $raw {} raw
  524.         # ?????? ??????    ... ??????
  525.         foreach    f $raw {
  526.         # ??????     (really about a bazillion numbers)
  527.         set path [specToPathName $f]
  528.         set tl [file tail $path]
  529.         set cwpaths($tl) $path
  530.         lappend    names $tl
  531.         }
  532.         set theReply [lsort -ignore $names]
  533.     } else {
  534.         # should never get here
  535.         set theReply {{(Not in current CW project}}
  536.     }
  537.     }
  538.     return $theReply
  539. }
  540.  
  541. # Called by Alpha to get list of include files for popup.
  542. proc cw::getIncludeFiles {} {
  543.     if {[catch {cw::include [win::CurrentTail]} ret]} {
  544.     error {{(* CodeWarrior not running *}}
  545.     }
  546.     return $ret
  547. }
  548.  
  549. proc cw::editIncludeFile {fname} {
  550.     global cwpaths
  551.     if [info exists cwpaths($fname)] {
  552.     file::openQuietly $cwpaths($fname)
  553.     } else {
  554.     error "Not found!"
  555.     }
  556. }
  557.  
  558.  
  559.  
  560.  
  561.